home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / Menus.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  12.9 KB  |  322 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {  Copyright (c) 1995-2001 Borland Software Corporation }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Menus;
  11.  
  12. {$S-,W-,R-,T-,H+,X+}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Contnrs, Messages, Graphics, ImgList, ActnList;
  18.  
  19. type
  20.   TMenuItem = class;
  21.  
  22.   EMenuError = class(Exception);
  23.   TMenu = class;
  24.   TMenuBreak = (mbNone, mbBreak, mbBarBreak);
  25.   TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem; Rebuild: Boolean) of object;
  26.   TMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  27.     ARect: TRect; Selected: Boolean) of object;
  28.   TAdvancedMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  29.     ARect: TRect; State: TOwnerDrawState) of object;
  30.   TMenuMeasureItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  31.     var Width, Height: Integer) of object;
  32.   TMenuItemAutoFlag = (maAutomatic, maManual, maParent);
  33.   TMenuAutoFlag = maAutomatic..maManual;
  34.  
  35. { TMenuActionLink }
  36.  
  37.   TMenuActionLink = class(TActionLink)
  38.   protected
  39.     FClient: TMenuItem;
  40.     procedure AssignClient(AClient: TObject); override;
  41.     function IsAutoCheckLinked: Boolean; virtual;
  42.     function IsCaptionLinked: Boolean; override;
  43.     function IsCheckedLinked: Boolean; override;
  44.     function IsEnabledLinked: Boolean; override;
  45.     function IsHelpContextLinked: Boolean; override;
  46.     function IsHintLinked: Boolean; override;
  47.     function IsGroupIndexLinked: Boolean; override;
  48.     function IsImageIndexLinked: Boolean; override;
  49.     function IsShortCutLinked: Boolean; override;
  50.     function IsVisibleLinked: Boolean; override;
  51.     function IsOnExecuteLinked: Boolean; override;
  52.     procedure SetAutoCheck(Value: Boolean); override;
  53.     procedure SetCaption(const Value: string); override;
  54.     procedure SetChecked(Value: Boolean); override;
  55.     procedure SetEnabled(Value: Boolean); override;
  56.     procedure SetHelpContext(Value: THelpContext); override;
  57.     procedure SetHint(const Value: string); override;
  58.     procedure SetImageIndex(Value: Integer); override;
  59.     procedure SetShortCut(Value: TShortCut); override;
  60.     procedure SetVisible(Value: Boolean); override;
  61.     procedure SetOnExecute(Value: TNotifyEvent); override;
  62.   end;
  63.  
  64.   TMenuActionLinkClass = class of TMenuActionLink;
  65.  
  66. { TMenuItem }
  67.  
  68.   TMenuItem = class(TComponent)
  69.   protected
  70.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  71.     procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
  72.       State: TOwnerDrawState; TopLevel: Boolean); virtual;
  73.     procedure AssignTo(Dest: TPersistent); override;
  74.     procedure DefineProperties(Filer: TFiler); override;
  75.     procedure DoDrawText(ACanvas: TCanvas; const ACaption: string;
  76.       var Rect: TRect; Selected: Boolean; Flags: Longint);
  77.     procedure DrawItem(ACanvas: TCanvas; ARect: TRect; Selected: Boolean); virtual;
  78.     function GetActionLinkClass: TMenuActionLinkClass; dynamic;
  79.     function GetHandle: HMENU;
  80.     function GetCount: Integer;
  81.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  82.     function GetItem(Index: Integer): TMenuItem;
  83.     function GetMenuIndex: Integer;
  84.     function GetAutoHotkeys: Boolean;
  85.     function GetAutoLineReduction: Boolean;
  86.     function InsertNewLine(ABefore: Boolean; AItem: TMenuItem): Integer;
  87.     procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); virtual;
  88.     procedure MenuChanged(Rebuild: Boolean); virtual;
  89.     procedure Loaded; override;
  90.     procedure Notification(AComponent: TComponent;
  91.       Operation: TOperation); override;
  92.     procedure SetBreak(Value: TMenuBreak);
  93.     procedure SetCaption(const Value: string);
  94.     procedure SetChecked(Value: Boolean);
  95.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  96.     procedure SetDefault(Value: Boolean);
  97.     procedure SetEnabled(Value: Boolean);
  98.     procedure SetGroupIndex(Value: Byte);
  99.     procedure SetImageIndex(Value: TImageIndex);
  100.     procedure SetMenuIndex(Value: Integer);
  101.     procedure SetParentComponent(Value: TComponent); override;
  102.     procedure SetRadioItem(Value: Boolean);
  103.     procedure SetShortCut(Value: TShortCut);
  104.     procedure SetVisible(Value: Boolean);
  105.     procedure UpdateItems;
  106.     property ActionLink: TMenuActionLink;
  107.   public
  108.     constructor Create(AOwner: TComponent); override;
  109.     destructor Destroy; override;
  110.     procedure InitiateAction; virtual;
  111.     procedure Insert(Index: Integer; Item: TMenuItem);
  112.     procedure Delete(Index: Integer);
  113.     procedure Clear;
  114.     procedure Click; virtual;
  115.     function Find(ACaption: string): TMenuItem;
  116.     function IndexOf(Item: TMenuItem): Integer;
  117.     function IsLine: Boolean;
  118.     function GetImageList: TCustomImageList;
  119.     function GetParentComponent: TComponent; override;
  120.     function GetParentMenu: TMenu;
  121.     function HasParent: Boolean; override;
  122.     function NewTopLine: Integer;
  123.     function NewBottomLine: Integer;
  124.     function InsertNewLineBefore(AItem: TMenuItem): Integer;
  125.     function InsertNewLineAfter(AItem: TMenuItem): Integer;
  126.     procedure Add(Item: TMenuItem); overload;
  127.     procedure Add(const AItems: array of TMenuItem); overload;
  128.     procedure Remove(Item: TMenuItem);
  129.     function RethinkHotkeys: Boolean;
  130.     function RethinkLines: Boolean;
  131.     property Command: Word;
  132.     property Handle: HMENU;
  133.     property Count: Integer;
  134.     property Items[Index: Integer]: TMenuItem; default;
  135.     property MenuIndex: Integer;
  136.     property Parent: TMenuItem;
  137.   published
  138.     property Action: TBasicAction;
  139.     property AutoCheck: Boolean default False;
  140.     property AutoHotkeys: TMenuItemAutoFlag default maParent;
  141.     property AutoLineReduction: TMenuItemAutoFlag default maParent;
  142.     property Bitmap: TBitmap;
  143.     property Break: TMenuBreak default mbNone;
  144.     property Caption: string;
  145.     property Checked: Boolean default False;
  146.     property SubMenuImages: TCustomImageList;
  147.     property Default: Boolean default False;
  148.     property Enabled: Boolean default True;
  149.     property GroupIndex: Byte default 0;
  150.     property HelpContext: THelpContext default 0;
  151.     property Hint: string;
  152.     property ImageIndex: TImageIndex default -1;
  153.     property RadioItem: Boolean default False;
  154.     property ShortCut: TShortCut default 0;
  155.     property Visible: Boolean default True;
  156.     property OnClick: TNotifyEvent;
  157.     property OnDrawItem: TMenuDrawItemEvent;
  158.     property OnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
  159.     property OnMeasureItem: TMenuMeasureItemEvent;
  160.   end;
  161.  
  162.   TFindItemKind = (fkCommand, fkHandle, fkShortCut);
  163.  
  164.   TMenu = class(TComponent)
  165.   protected
  166.     procedure AdjustBiDiBehavior;
  167.     procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
  168.     procedure DoBiDiModeChanged;
  169.     function DoGetMenuString(Menu: HMENU; ItemID: UINT; Str: PChar;
  170.       MaxCount: Integer; Flag: UINT): Integer;
  171.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  172.     function GetHandle: HMENU; virtual;
  173.     function IsOwnerDraw: Boolean;
  174.     procedure Loaded; override;
  175.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); virtual;
  176.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  177.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  178.     procedure UpdateItems;
  179.     property OnChange: TMenuChangeEvent;
  180.   public
  181.     constructor Create(AOwner: TComponent); override;
  182.     destructor Destroy; override;
  183.     function DispatchCommand(ACommand: Word): Boolean;
  184.     function DispatchPopup(AHandle: HMENU): Boolean;
  185.     function FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
  186.     function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
  187.     property Images: TCustomImageList;
  188.     function IsRightToLeft: Boolean;
  189.     function IsShortCut(var Message: TWMKey): Boolean; dynamic;
  190.     procedure ParentBiDiModeChanged; overload;
  191.     procedure ParentBiDiModeChanged(AControl: TObject); overload;
  192.     procedure ProcessMenuChar(var Message: TWMMenuChar);
  193.     property AutoHotkeys: TMenuAutoFlag default maAutomatic;
  194.     property AutoLineReduction: TMenuAutoFlag default maAutomatic;
  195.     property BiDiMode: TBiDiMode;
  196.     property Handle: HMENU;
  197.     property OwnerDraw: Boolean default False;
  198.     property ParentBiDiMode: Boolean default True;
  199.     property WindowHandle: HWND;
  200.   published
  201.     property Items: TMenuItem;
  202.   end;
  203.  
  204.   TMainMenu = class(TMenu)
  205.   protected
  206.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  207.     function GetHandle: HMENU; override;
  208.   public
  209.     procedure Merge(Menu: TMainMenu);
  210.     procedure Unmerge(Menu: TMainMenu);
  211.     procedure PopulateOle2Menu(SharedMenu: HMenu; const Groups: array of Integer;
  212.       var Widths: array of Longint);
  213.     procedure GetOle2AcceleratorTable(var AccelTable: HAccel;
  214.       var AccelCount: Integer; const Groups: array of Integer);
  215.     procedure SetOle2MenuHandle(Handle: HMENU);
  216.   published
  217.     property AutoHotkeys;
  218.     property AutoLineReduction;
  219.     property AutoMerge: Boolean default False;
  220.     property BiDiMode;
  221.     property Images;
  222.     property OwnerDraw;
  223.     property ParentBiDiMode;
  224.     property OnChange;
  225.   end;
  226.  
  227.   TPopupAlignment = (paLeft, paRight, paCenter);
  228.   TTrackButton = (tbRightButton, tbLeftButton);
  229.   TMenuAnimations = (maLeftToRight, maRightToLeft, maTopToBottom, maBottomToTop, maNone);
  230.   TMenuAnimation = set of TMenuAnimations;
  231.  
  232.   TPopupMenu = class(TMenu)
  233.   protected
  234.     function UseRightToLeftAlignment: Boolean;
  235.     procedure DoPopup(Sender: TObject); virtual;
  236.   public
  237.     constructor Create(AOwner: TComponent); override;
  238.     destructor Destroy; override;
  239.     procedure Popup(X, Y: Integer); virtual;
  240.     property PopupComponent: TComponent;
  241.     property PopupPoint: TPoint;
  242.   published
  243.     property Alignment: TPopupAlignment default paLeft;
  244.     property AutoHotkeys;
  245.     property AutoLineReduction;
  246.     property AutoPopup: Boolean default True;
  247.     property BiDiMode;
  248.     property HelpContext: THelpContext default 0;
  249.     property Images;
  250.     property MenuAnimation: TMenuAnimation default [];
  251.     property OwnerDraw;
  252.     property ParentBiDiMode;
  253.     property TrackButton: TTrackButton default tbRightButton;
  254.     property OnChange;
  255.     property OnPopup: TNotifyEvent;
  256.   end;
  257.  
  258.   TPopupList = class(TList)
  259.   protected
  260.     FWindow: HWND;
  261.     procedure MainWndProc(var Message: TMessage);
  262.     procedure WndProc(var Message: TMessage); virtual;
  263.   public
  264.     property Window: HWND;
  265.     procedure Add(Popup: TPopupMenu);
  266.     procedure Remove(Popup: TPopupMenu);
  267.   end;
  268.  
  269.   PMenuItem = ^TMenuItem;
  270.  
  271.   TMenuItemStack = class(TStack)
  272.   public
  273.     procedure ClearItem(AItem: TMenuItem);
  274.   end;
  275.  
  276. var
  277.   PopupList: TPopupList;
  278.   ShortCutItems: TMenuItemStack;
  279.  
  280. function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
  281. procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
  282. function ShortCutToText(ShortCut: TShortCut): string;
  283. function TextToShortCut(Text: string): TShortCut;
  284.  
  285. function NewMenu(Owner: TComponent; const AName: string; const Items: array of TMenuItem): TMainMenu;
  286. function NewPopupMenu(Owner: TComponent; const AName: string;
  287.   Alignment: TPopupAlignment; AutoPopup: Boolean; const Items: array of TMenuItem): TPopupMenu;
  288. function NewSubMenu(const ACaption: string; hCtx: THelpContext;
  289.   const AName: string; const Items: array of TMenuItem; AEnabled: Boolean = True): TMenuItem;
  290. function NewItem(const ACaption: string; AShortCut: TShortCut;
  291.   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
  292.   const AName: string): TMenuItem;
  293. function NewLine: TMenuItem;
  294.  
  295. procedure DrawMenuItem(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect;
  296.   State: TOwnerDrawState);
  297.  
  298. var
  299.   { These are the hotkeys that the auto-hotkey system will pick from.
  300.     Change this global variable at runtime if you want to add or remove
  301.     characters from the available characters.  Notice that by default we
  302.     do not do international characters. }
  303.   ValidMenuHotkeys: string = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'; { do not localize }
  304.  
  305. const
  306.   cHotkeyPrefix = '&';
  307.   cLineCaption = '-';
  308.   cDialogSuffix = '...';
  309.  
  310. { StripHotkey removes the & escape char that marks the hotkey character(s) in
  311.   the string.  When the current locale is a Far East locale, this function also
  312.   looks for and removes parens around the hotkey, common in Far East locales. }
  313. function StripHotkey(const Text: string): string;
  314.  
  315. { GetHotkey will return the last hotkey that StripHotkey would strip. }
  316. function GetHotkey(const Text: string): string;
  317.  
  318. { Similar to AnsiSameText but strips hotkeys before comparing }
  319. function AnsiSameCaption(const Text1, Text2: string): Boolean;
  320.  
  321. implementation
  322.